AMIGA-CD 2/Amiga-CD - Volume 2.iso/ungepackte_daten/1992/11/02/virtual memory/virtualmemory.mod

Text File | 1995-06-01 | 31.3 KB | 1,178 lines

$$LongAllign:=FALSE
$$ConstChk:=FALSE
MODULE VirtualMemory;

FROM Exec      IMPORT SuperState,UserState,CopyMemQuick,Forbid,Permit,Alert;
FROM Resources IMPORT New,Dispose,Allocate;
FROM System    IMPORT BITSET,Regs,PROC,LONGSET,SHORTSET;
               IMPORT Dos;

|
| Terminiere das Programm mit einem AutoRequest, der die Fehlerursache
| anzeigt.
|
PROCEDURE Terminate(REF alert : LIST OF STRING);
FROM Graphics  IMPORT TextAttr;
FROM Intuition IMPORT AutoRequest,IntuiText;
CONST
  Topaz   = TextAttr:(name="topaz.font".data'PTR,ySize=11);
  Ok      = IntuiText:(frontPen=2,leftEdge=5,topEdge=4,
                       iTextFont=Topaz'PTR,
                       iText="Give Up".data'PTR);
VAR lines   : ARRAY [10] OF IntuiText;
    i,j,x,w : INTEGER;
BEGIN
  w:=0;
  FOR i:=0 TO alert'MAX DO
    IF alert[i].len>w THEN w:=alert[i].len END
  END;
  w:=w*8+20;
  FOR i:=0 TO alert'MAX DO
    WITH lines[i] AS l DO
      IF i#alert'MAX THEN
        l.nextText:=lines[SUCC(i)]'PTR;
      ELSE
        l.nextText:=NIL;
      END;
      l.frontPen:=2;
      l.iTextFont:=Topaz'PTR;
      l.iText:=alert[i].data'PTR;
      l.topEdge:=20+10*i;
      l.leftEdge:=(w-alert[i].len*8) DIV 2;
    END;
  END;
  FORGET AutoRequest(NIL,lines[0]'PTR,NIL,Ok'PTR,{},{},w,alert'RANGE*10+40);
  HALT(10);
END Terminate;

VAR
  SwapFileName   : STRING(100);
  PhysSize       : LONGINT;
  SwapSize       : LONGINT;
  LookAhead      : LONGINT := 8;
  VMemBase       : LONGINT := $08000000;

TYPE
  LongPtr        = POINTER TO LONGINT;

TYPE
  MMURootFlags   = (dt0,dt1,lu=31);
  MMURootFlagSet = SET OF MMURootFlags;
  MMUTCFlags     = (tid0,tid1,tid2,tid3,
                    tic0,tic1,tic2,tic3,
                    tib0,tib1,tib2,tib3,
                    tia0,tia1,tia2,tia3,
                    is0,is1,is2,is3,
                    ps0,ps1,ps2,ps3,
                    fcl,sre,enable=31);
  MMUTCFlagSet   = SET OF MMUTCFlags;

  MMUTransFlags  = (valid0,valid1,
                    usedBefore,
                    touched,
                    modified,mmut5,
                    cacheable,mmut6,mmut31 = 31);
  MMUTransFlagSet= SET OF MMUTransFlags;
  MMUTPtr        = POINTER TO MMUTransFlagSet;

  LevelAPtr      = POINTER TO ARRAY [256] OF LONGINT;
  LevelBPtr      = POINTER TO ARRAY [32] OF LONGINT;
  LevelCPtr      = POINTER TO ARRAY [64] OF MMUTransFlagSet;
  LevelBCPtr     = POINTER TO ARRAY [32],[64] OF LONGINT;
  LevelCCPtr     = POINTER TO ARRAY [2048] OF LONGINT;

  MMUConfig      = RECORD
                     rootData : MMURootFlagSet;
                     rootPos  : ANYPTR;
                     tc       : MMUTCFlagSet;
                     levelA   : LevelAPtr;
                   END;

  VMemNodePtr    = POINTER TO VMemNode;
  VMemNode       = RECORD
                     next  : VMemNodePtr;
                     pos,
                     vpos  : LONGINT;
                     mmu   : MMUTPtr;
                     clear : BOOLEAN;
                   END;
  VMemMsgPtr     = POINTER TO VMemMsg;
  VMemMsg        = RECORD OF Exec.Message;
                     pos   : ANYPTR;
                   END;

  ShortExFrame = POINTER TO RECORD
                   regs    : ARRAY [15] OF LONGINT;
                   status  : BITSET;
                   pc      : ANYPTR;
                   vector  : CARDINAL;
                   res1    : CARDINAL;
                   special : BITSET;
                   res2,
                   res3    : CARDINAL;
                   fault   : ANYPTR;
                 END;

CONST
  NodeSize   = $2000;

  oldIllegal = ARRAY OF PROC:(NIL);
  myA4       = ARRAY OF LONGINT:(0);

  MemSem     = Exec.SignalSemaphore:();

VAR
  LastMem      : VMemNodePtr;
  ServerPort   : Exec.MsgPort;

  VBR          : LONGINT;

  lowMem       : LONGINT;
  highMem      : LONGINT;

  SysMMU       : MMUConfig;
  OwnMMU       : MMUConfig;

  Thrashing    : BOOLEAN;

  isA3000      : BOOLEAN;

  mem          : Exec.MemHeaderPtr;

DEFINITION MODULE DiskIO;
|
| IO Routinenen, die die Unterschiede zwischen einem File und einer Partition
| vor einem übergeordneten Benutzer verbergen.
|

  PROCEDURE Open(REF name : STRING;VAR size : LONGINT);

  PROCEDURE Close;

  PROCEDURE Read(dst : ANYPTR;pos,len : LONGINT);

  PROCEDURE Write(src : ANYPTR;pos,len : LONGINT);

  PROCEDURE MotorOff;

END DiskIO;

IMPLEMENTATION MODULE DiskIO;

  FROM Resources IMPORT New,Dispose,Allocate;
  FROM System    IMPORT Regs;
  FROM Dos       IMPORT DeviceListPtr;
  FROM Exec      IMPORT IOStdReq,DoIO,read,write;
  FROM Trackdisk IMPORT IOTrackDiskPtr;
                 IMPORT Strings;
  FROM Str       IMPORT CAP;

  VAR SwapFile  : Dos.FileHandlePtr;
      SwapPos   : LONGINT;
      Device    : IOTrackDiskPtr;
      sigBit    : INTEGER;
      port      : Exec.MsgPortPtr;
      BlockSize : INTEGER;
      Base      : LONGINT;
      Size      : LONGINT;

  PROCEDURE Open(REF name : STRING;VAR size : LONGINT);
  VAR i,oldLen  : LONGINT;
      buffer    : POINTER TO ARRAY [16*NodeSize] OF SHORTCARD;
      dev       : DeviceListPtr;
      name2     : STRING(40);
      bpcyl     : LONGINT;
      root      : LONGINT;
      RootBlock : POINTER TO ARRAY OF LONGINT;
      blkSize   : LONGINT;
      ee        : POINTER TO Dos.DosEnvec;

    PROCEDURE FindDevEntry(REF name : STRING):DeviceListPtr;
    VAR p : DeviceListPtr;

      PROCEDURE Equal(new : Dos.BSTR):BOOLEAN;
      VAR s IN A0,d IN A1 : POINTER TO CHAR;
      BEGIN
        IF new#NIL THEN
          s:=new^'PTR;
          d:=name.data[0]'PTR;
          IF name.len=INTEGER(s+^) THEN
            LOOP
              IF KEY CAP[d+^]
                OF &0       THEN RETURN TRUE END
                OF CAP[s+^] THEN             END
              ELSE
                RETURN FALSE
              END;
            END;
          ELSE
            RETURN FALSE
          END;
        ELSE
          RETURN FALSE
        END;
      END Equal;

    BEGIN
      Exec.Forbid;
      p:=Dos.DosBase.root.info^.devInfo;
      WHILE (p#NIL) AND
            ((p^.type#Dos.device) OR NOT Equal(p^.name)) DO p:=p^.next END;
      Exec.Permit;
      RETURN p;
    END FindDevEntry;

  BEGIN
    IF name.data[name.len-1]=":" THEN
      name2:=name;DEC(name2.len);name2.data[name2.len]:=&0;
      dev:=FindDevEntry(name2);
      IF (dev#NIL) AND (dev^.startup#NIL) AND (dev^.startup^.environ#NIL) THEN
        ee:=dev^.startup^.environ^'PTR;
        WITH ee^ AS e DO
          blkSize:=e.sizeBlock;
          bpcyl:=e.sizeBlock*e.surfaces*e.blocksPerTrack*4;
          Base:=LONGINT(e.lowCyl)*bpcyl;
          Size:=LONGINT(e.highCyl+1-e.lowCyl)*bpcyl;
          root:=((e.highCyl+1+e.lowCyl)*e.blocksPerTrack*e.surfaces+1) DIV 2;
        END;
        IF size=0 THEN size:=Size DIV (16*NodeSize) * (16*NodeSize) END;
        IF Size>=size THEN
          Exec.OpenDevice(Strings.BSTRtoString(dev^.startup^.device),dev^.startup^.unit,Device^,{});
          |Exec.OpenDevice("trackdisk.device",0,Device^,{});
          IF Device.error=0 THEN
            Allocate(RootBlock,blkSize*4);
            Device.command:=Exec.read;
            Device.length:=blkSize*4;
            Device.data:=RootBlock;
            Device.offset:=Base;
            Exec.DoIO(Device);
            IF Device.error=0 THEN
              IF RootBlock[0] OF $444F5300,$444F5301 THEN
                Device.command:=Exec.read;
                Device.length:=blkSize*4;
                Device.data:=RootBlock;
                Device.offset:=root*blkSize*4;
                Exec.DoIO(Device);
                IF Device.error=0 THEN
                  IF (RootBlock[0]=2) AND (RootBlock[blkSize-1]=1) THEN
                    FOR i:=6 TO 5+RootBlock[3] DO
                      IF RootBlock[i]#0 THEN
                        Exec.CloseDevice(Device^);
                        Device.device:=NIL;
                        Dispose(RootBlock);
                        Terminate("Partition error:",
                                "Partition is not empty",
                                "Please delete all files");
                      END;
                    END;
                  END;
                END;
              END;
              Dispose(RootBlock);
            ELSE
              Exec.CloseDevice(Device^);
              Device.device:=NIL;
              Dispose(RootBlock);
              Terminate("Partition error:",
                      "Read error");
            END;
          ELSE
            Terminate("Partition error:",
                    "Read error");
          END;
        ELSE
          Terminate("Partition error:",
                  "Partition too small");
        END;
      ELSE
        Terminate("Partition error:",
                  "Partition does not exist",
                  "Use physical name !!");
      END;
    ELSE
      IF size=0 THEN
        Terminate("Swapfile error:",
                "Size 0 can not be used",
                "for file swapping",
                "Use 'FILESIZE=...'",
                "In blocks of 128KBytes");
      END;
      SwapFile:=Dos.Open(name,Dos.readWrite);
      IF SwapFile#NIL THEN
        Size:=size;
        New(buffer);
        FOR i:=0 TO 16*NodeSize-1 DO
          buffer[i]:=0
        END;
        FORGET Dos.Seek(SwapFile,0,Dos.end);
        oldLen:=Dos.Seek(SwapFile,0,Dos.current);
        FOR i:=oldLen DIV (16*NodeSize) TO Size DIV (16*NodeSize) -1 DO
          IF Dos.Write(SwapFile,buffer,16*NodeSize)#16*NodeSize THEN
            Terminate("Swapfile error:",
                    "Not enough disk space");
          END;
        END;
        SwapPos:=0;
        FORGET Dos.Seek(SwapFile,0,Dos.beginning);
        Dispose(buffer);
      ELSE
        Terminate("Swapfile error:",
                "could not open Swapfile");
      END;
    END;
  END Open;

  PROCEDURE Close;
  BEGIN
    IF SwapFile#NIL THEN
      Dos.Close(SwapFile)
    ELSE
      Exec.CloseDevice(Device^);
    END;
  END Close;

  PROCEDURE Read(dst : ANYPTR;pos,len : LONGINT);
  BEGIN
    IF pos OF 0..Size-1 THEN
      IF SwapFile#NIL THEN
        FORGET Dos.Seek(SwapFile,pos-SwapPos,Dos.current);
        FORGET Dos.Read(SwapFile,dst,len);
        SwapPos:=pos+len;
      ELSE
        Device.command:=Exec.read;
        Device.length:=len;
        Device.data:=dst;
        Device.offset:=pos+Base;
        Exec.DoIO(Device);
      END;
    END;
  END Read;

  PROCEDURE Write(src : ANYPTR;pos,len : LONGINT);
  BEGIN
    IF pos OF 0..Size-1 THEN
      IF SwapFile#NIL THEN
        FORGET Dos.Seek(SwapFile,pos-SwapPos,Dos.current);
        FORGET Dos.Write(SwapFile,src,len);
        SwapPos:=pos+len;
      ELSE
        Device.command:=Exec.write;
        Device.length:=len;
        Device.data:=src;
        Device.offset:=pos+Base;
        Exec.DoIO(Device);
      END;
    END;
  END Write;

  PROCEDURE MotorOff;
  BEGIN
    IF SwapFile=NIL THEN
      Device.command:=Trackdisk.motor;
      Device.length:=0;
      Exec.DoIO(Device);
    END;
  END MotorOff;

BEGIN
  sigBit:=Exec.AllocSignal(-1);
  New(port,clear:=TRUE);
  New(Device,clear:=TRUE);
  port.name:=NIL;
  port.pri:=0;
  port.type:=Exec.msgPort;
  port.flags:=Exec.signal;
  port.sigBit:=sigBit;
  port.sigTask:=Exec.FindTask(NIL);
  Exec.NewList(port.msgList,Exec.message);
  Device.type:=Exec.message;
  Device.replyPort:=port;
CLOSE
  IF SwapFile#NIL THEN
    Dos.Close(SwapFile);SwapFile:=NIL;
  END;
  IF Device.device#NIL THEN
    Exec.CloseDevice(Device^);
    Device.device:=NIL
  END;
  Exec.FreeSignal(sigBit);
END DiskIO;

|
| GetVBR:
|
|  Inhalt des Vector Base Registers ermitteln, da dieses die Basisadresse der
|  Exceptionvektoren enthält.
|
PROCEDURE GetVBR():LONGINT;
BEGIN
  ASSEMBLE(MOVE.L $4,A6
           JSR    -$96(A6)            | SuperState
           DC.W   $4E7A,$2801         | MOVEC VBR,D2
           JSR    -$9C(A6)            | UserState
           MOVE.L D2,D0               | Returnwert.
          );
END GetVBR;

|
| GetMMUConfig:
|
|   Aktuellen Zustand der MMU ermitteln
|
PROCEDURE GetMMUConfig(VAR con IN A2 : MMUConfig);
BEGIN
  ASSEMBLE(MOVE.L $4,A6
           JSR    -$96(A6)            | SuperState
           DC.W   $F012,$4E00         | PMOVE CRP,(A2)
           DC.W   $F02A,$4200,$0008   | PMOVE TC,8(A2)
           JSR    -$9C(A6)            | UserState
          );
END GetMMUConfig;

|
| PutMMUConfig:
|
|   Zustand der MMU ändern
|
PROCEDURE PutMMUConfig(REF con IN A2 : MMUConfig);
BEGIN
  ASSEMBLE(MOVE.L $4,A6
           JSR    -120(A6)
           JSR    -$96(A6)          | SuperState
           DC.W   $42A7,$F017
           DC.W   $4000,$588F       | CLR   TC
           DC.W   $F012,$4C00       | PMOVE CRP,(A2)
           DC.W   $F02A,$4000,$0008 | PMOVE TC,8(A2)
           JSR    -$9C(A6)          | UserState
           JSR    -126(A6)
          );
END PutMMUConfig;

|
| InvalidateMMUCache:
|
|   Seitendeskriptor im MMU cache invalidieren, ist unbedingt nötig, wenn
|   dieser geändert wurde, da nur so die Änderung in die MMU übernommen wird.
|   Alternativ könnte auch der PFLUSHA verwendet werden, der allerdings alle
|   MMU cache Einträge invalidiert.
|
PROCEDURE InvalidateMMUCache(pos : LONGINT);
BEGIN
  ASSEMBLE(MOVE.L $4,A6
           JSR    -$96(A6)      | SuperState
           MOVE.L pos,A0
           DC.W   $F010,$3810   | PFLUSH #0,#0,(A0)
           JSR    -$9C(A6)      | UserState
          );
END InvalidateMMUCache;

|
| New16:
|
|   Ein Speicherblock auf 16Byte Grenze Allozieren, nötig, da alle MMU Elemente
|   auf 16 byte allignment angewiesen sind.
|
PROCEDURE New16(VAR a : ANYPTR);
BEGIN
  Allocate(a,a'SIZE+16);
  IF LONGINT(a) MOD 16#0 THEN INC(LONGINT(a),8) END;
END New16;

|
| CreateMMUTree:
|
|  Standard MMU Baum erzeugen.
|
|   Zu Berücksichtigen sind:
|
|     Chip Memory
|     Kickstart rom auf A3000
|     IO Bereich
|
|   Caching bräuchte allerdings nicht durch die MMU realsisert werden (zu
|   mindest nicht mit '030, da das caching auf diesem Prozessor auch durch
|   externe Hardware unterbunden werden kann. Auf Prozessoren mit einem
|   CopyBack modus ist dies nicht möglich, da eventuell für ein zu schreibendes
|   Datenwort überhaupt kein Speicherzugriff erfolgt.
|
PROCEDURE CreateMMUTree(VAR con : MMUConfig);
VAR levelA : LevelAPtr;
    levelB : LevelBPtr;
    i      : INTEGER;
BEGIN
  con.tc:={enable,          | MMU ist aktiv
           ps3,ps2,ps0,     | Page size 8 K (könnte evtl. Parameter werden)
           tia3,            | 8 Bits level A
           tib2,tib0,       | 5 Bits level B
           tic2,tic1        | 6 Bits level C
           };               | + 13 Bits rest => 32 Bits physical

  |
  | Root mit early termination, Addresse und DT = $1 für PageDescriptor
  |
  New16(levelA);
  con.levelA:=levelA;
  FOR i:=0 TO 255 DO
    levelA[i]:=LONGINT(i) SHL 24+%00000001;
  END;

  |
  | Level B, für Chip mem und evtl. Rom remapping
  |
  New16(levelB);
  levelA[$00]:=LONGINT(levelB)+%10;
  FOR i:=0 TO 3 DO
    levelB[i]:=$00000000+LONGINT(i) SHL 19+%01000001;
  END;
  FOR i:=4 TO 30 DO
    levelB[i]:=$00000000+LONGINT(i) SHL 19+%00000001;
  END;

  |
  | für A3000 muß das Kickstart mit der MMU evtl. remapped werden
  |
  IF isA3000 THEN
    levelB[31]:=$07F80000+%00000101;
    New16(levelB);
    levelA[$07]:=LONGINT(levelB)+%10;
    FOR i:=0 TO 30 DO
      levelB[i]:=$07000000+LONGINT(i) SHL 19+%00000001;
    END;
    levelB[31]:=$07F80000+%00000101;
  END;

  |
  | levelA zeiger eintragen, Flags für Short descriptoren
  |
  con.rootPos:=levelA;
  con.rootData:={lu,dt1};
END CreateMMUTree;

|
| CreateVMemArea:
|
|   Virtuellen Bereich im MMU Baum eintragen
|
PROCEDURE CreateVMemArea(VAR con : MMUConfig;from,to : ANYPTR);
VAR levelB : LevelBPtr;
    levelC : LevelBCPtr;
    i,j,k  : INTEGER;
BEGIN
  FOR k:=LONGINT(from) SHR 24 TO (to-1) SHR 24 DO
    New16(levelB);
    New16(levelC);
    FOR i:=0 TO 31 DO
      levelB[i]:=LONGINT(levelC[i]'PTR)+%00000010;
      FOR j:=0 TO 63 DO
        levelC[i,j]:=0;
      END;
    END;
    con.levelA[k]:=LONGINT(levelB)+%00000010;
  END;
  lowMem:=from;
  highMem:=to;
END CreateVMemArea;

|
| AddBuffers:
|
|   Pufferspeicher für eingelagerte Seiten anfordern und den Bestehenden
|   hinzufügen.
|
PROCEDURE AddBuffers(buff : INTEGER);
VAR mem  : ANYPTR;
    node : VMemNodePtr;
    i    : INTEGER;
BEGIN
  Allocate(mem,LMUL(buff+1,NodeSize));
  mem:=(LONGINT(mem)+NodeSize-1) DIV NodeSize * NodeSize;
  FOR i:=1 TO buff DO
    New(node);
    node.pos:=mem;
    node.mmu:=NIL;
    node.clear:=FALSE;
    Forbid;
    IF LastMem=NIL THEN
      LastMem:=node;
      node.next:=node
    ELSE
      node.next:=LastMem.next;
      LastMem.next:=node;
    END;
    Permit;
    INC(mem,NodeSize);
  END;
END AddBuffers;

|
| NextVMemNode:
|
|   Nächste zu verwendende Seite im physikalischen Speicher ermitteln. Die
|   Routine verwendet einen second chance algorithmus, der einem echten LRU
|   sehr nahe kommt, diesem aber an Leistung weit überlegen ist.
|
PROCEDURE NextMemNode():VMemNodePtr;
VAR p IN A0 : VMemNodePtr;
BEGIN
  p:=LastMem;
  WHILE (p.mmu#NIL) AND (touched IN p.mmu^) DO
    EXCL(p.mmu^,touched);
    p:=p.next
  END;
  LastMem:=p.next;
  RETURN p
END NextMemNode;

|
| InvalidateNode:
|
|   Eine Seite invalidieren, also aus der Menge erreichbaren Seiten entfernen.
|   Falls die Seite veränder worden ist, muß sie danach auf die Disk gesichert
|   werden.
|
PROCEDURE InvalidateNode(node : VMemNodePtr);
BEGIN
  IF node.mmu#NIL THEN
    EXCL(node.mmu^,valid0);
    InvalidateMMUCache(node.vpos);
    IF modified IN node.mmu^ THEN
      node.clear:=FALSE;
      DiskIO.Write(node.pos,node.vpos-lowMem,NodeSize);
      INCL(node.mmu^,usedBefore);
      Thrashing:=TRUE;
    OR_IF NOT node.clear THEN
      INCL(node.mmu^,usedBefore);
    END;
    node.mmu:=NIL;
  END;
END InvalidateNode;

|
| FlushNode:
|
|   Eine Seite, falls diese verändert wurde, auf die Disk sichern, und wieder
|   als unverändert markieren.
|
PROCEDURE FlushNode(node : VMemNodePtr);
BEGIN
  IF (node.mmu#NIL) AND (modified IN node.mmu^) THEN
    EXCL(node.mmu^,modified);
    InvalidateMMUCache(node.vpos);
    node.clear:=FALSE;
    DiskIO.Write(node.pos,node.vpos-lowMem,NodeSize);
  END;
END FlushNode;

|
| FlushNodes:
|
|   Eine vorgegebene Anzahl von Seiten für eine evtl. spätere Benutzung
|   freiräumen, also falls diese verändert wurden auf die Disk sichern.
|
|   Dieses speichern in größeren Stückzahlen hat den Vorteil, daß es
|   optimiert, also in der richtigen Reihenfolge (Kopfbewegungsoptimierung)
|   ausgeführt werden kann.
|
PROCEDURE FlushNodes(n : INTEGER);
VAR buff  : ARRAY [256] OF VMemNodePtr;
    num,i : INTEGER;
    j     : INTEGER;
    p     : VMemNodePtr;
BEGIN
  p:=LastMem;
  num:=0;
  FOR i:=1 TO n DO
    IF (p.mmu#NIL) AND (touched NOT IN p.mmu^) AND (modified IN p.mmu^) THEN
      j:=num;
      WHILE (j>0) AND (buff[j-1].vpos>p.vpos) DO
        buff[j]:=buff[j-1];
        DEC(j)
      END;
      buff[j]:=p;
      INC(num);
    END;
    p:=p.next;
  END;
  IF num>0 THEN
    FOR i:=0 TO num-1 DO
      FlushNode(buff[i]);
    END;
  END;
END FlushNodes;

|
| ClearMem:
|
|   Speicherbereich mit Nullen auffüllen.
|
PROCEDURE ClearMem(pos : ANYPTR;size : LONGINT);
VAR p IN A0 : POINTER TO LONGINT;
    i IN D1,
    j IN D2 : LONGINT;
BEGIN
  p:=pos;
  j:=0;
  FOR i:=size DIV 4-1 TO 0 BY -1 DO
    p+^:=j
  END;
END ClearMem;

|
| ReloadNode:
|
|   Eine verdrängte oder noch nicht benutzte Seite dem System zugängig machen.
|   Dies kann entweder durch einladen von Disk, oder durch Löschen (falls die
|   Seite noch nicht benutzt wurde) geschehen.
|
PROCEDURE ReloadNode(node : VMemNodePtr;pos : LONGINT;mmu : MMUTPtr);
BEGIN
  node.mmu:=mmu;
  node.vpos:=pos;
  IF usedBefore IN mmu^ THEN
    node.clear:=FALSE;
    DiskIO.Read(node.pos,node.vpos-lowMem,NodeSize);
  ELSE
    IF NOT node.clear THEN
      ClearMem(node.pos,NodeSize);
      node.clear:=TRUE;
    END;
  END;
  mmu^:=CAST(MMUTransFlagSet,node.pos)+{valid0,touched};
  InvalidateMMUCache(node.vpos);
END ReloadNode;

|
| SwapMemIn:
|
|    Sorgt dafür, daß die angegebene Adresse dem System zugängig gemacht
|    wird. Diese Funktion führt eventuell zu Disketten Zugriffen.
|
PROCEDURE SwapMemIn(pos : LONGINT);
VAR mmu  : MMUTPtr;
    mem  : LONGINT;
    node : VMemNodePtr;
BEGIN
  mem:=pos DIV NodeSize * NodeSize;
  mmu:=LevelCPtr(
       LevelBPtr(OwnMMU.levelA[mem SHR 24 MOD 256] SHR 4 SHL 4)
                              [mem SHR 19 MOD 32] SHR 4 SHL 4)
                              [mem SHR 13 MOD 64]'PTR;
  IF valid0 NOT IN mmu^ THEN
    node:=NextMemNode();
    InvalidateNode(node);
    ReloadNode(node,mem,mmu);
  END;
END SwapMemIn;

|
| Server:
|
|    Hauptschleife des Virtuell Memory Managers. Bekommt Anforderungen von
|    Prozessen/Tasks, die einen gewünschten Speicherbereich nicht erreichen
|    konnten, und deshalb in einer BusError Exception gelandet sind.
|
PROCEDURE Server;
VAR msg : VMemMsgPtr;
BEGIN
  LOOP
    Thrashing:=FALSE;
    msg:=Exec.WaitPort(ServerPort'PTR);
    msg:=Exec.GetMsg(ServerPort'PTR);
    WHILE msg#NIL DO
      SwapMemIn(msg.pos);
      Exec.ReplyMsg(msg);
      msg:=Exec.GetMsg(ServerPort'PTR);
    END;
    IF Thrashing THEN
      FlushNodes(LookAhead);
    END;
  END;
END Server;

|
| MMUCall:
|
|   High level Routine des BusError Exceptionhandlers. Erzeugt einen Port,
|   und richtet eine Anforderung an den Swapper process.
|
|   Die Einrichtung eines Ports ist etwas fragwürdig, doch kann aus
|   Verständlichen Gründen in dieser Routine kein Speicher angefordert werden.
|   Da Stack Speicher aber sowieso im Public memory liegen sollte, sollte dies
|   keine Probleme machen.
|
PROCEDURE MMUCall(frame : ShortExFrame);
VAR task : Exec.TaskPtr;
    msg  : VMemMsg;
    port : Exec.MsgPort;
BEGIN
  IF LONGINT(frame.fault) OF lowMem..highMem-1 THEN
    port.flags:=Exec.signal;
    port.sigBit:=Exec.AllocSignal(-1);
    port.sigTask:=Exec.FindTask(NIL);
    port.msgList.head:=Exec.NodePtr(port.msgList.tail'PTR);
    port.msgList.tail:=NIL;
    port.msgList.tailPred:=Exec.NodePtr(port.msgList.head'PTR);
    msg.replyPort:=port'PTR;
    msg.pos:=frame.fault;
    Exec.PutMsg(ServerPort'PTR,msg'PTR);
    REPEAT
      FORGET Exec.WaitPort(port'PTR);
    UNTIL Exec.GetMsg(port'PTR)#NIL;
    Exec.FreeSignal(port.sigBit);
  ELSE
    EXCL(frame.special,8);
  END;
END MMUCall;

|
| BusError:
|
|    Low level BusError Exception Handler, sichert den Exception frame
|    auf dem user stack, schaltet in user mode zurück und ruft MMUCall
|    auf.
|
PROCEDURE BusError;
BEGIN
  ASSEMBLE(
           |
           | Register sichern, und Variablenbasis holen
           |
           MOVE.L D0-D7/A0-A6,-(A7)
           MOVE.L myA4[0],A4
           |
           | Feststellen ob short oder long frame
           |
           DC.W   $4E68               | MOVE.L USP,A0
           BTST   #4,{$6+60}(A7)      | Test auf Typ des Frames
           BNE    lFrame
           |
           | ShortFrame:
           |
           | Exception frame auf user stack kopieren
           |
           MOVE.L #30+16-1,D0
           SUB.L  #60+32,A0
           DC.W   $4E60               | MOVE.L A0,USP
           MOVE.L A7,A1
  sLoop:   MOVE.W (A1)+,(A0)+
           DBRA   D0,sLoop
           ADD.L  #60+32,A7
           |
           | In user mode zurück schalten
           |
           DC.W   $027C,$DFFF         | Back to user Mode
           |
           | High level Routine aufrufen
           |
           PEA    (A7)
           JSR    MMUCall
           |
           | Zurück in supervisor mode
           |
           MOVE.L 4,A6
           JSR    -$96(A6)            | Supervisor
           |
           | Exception frame wieder auf Supervisor Stack
           |
           MOVE.L A7,A0               | User Stack
           MOVE.L D0,A7               | Supervisorstack
           SUB.L  #60+32,A7
           MOVE.L A7,A1
           MOVE.L #30+16-1,D0
  sLoop2:  MOVE.W (A0)+,(A1)+
           DBRA   D0,sLoop2
           DC.W   $4E60               | MOVE.L A0,USP
           |
           | Und raus hier
           |
           BRA    exit
           |
           | LongFrame:
           |
           | Exception frame auf user stack kopieren
           |
  lFrame:  MOVE.L #30+46-1,D0
           SUB.L  #60+92,A0
           DC.W   $4E60               | MOVE.L A0,USP
           MOVE.L A7,A1
  lLoop:   MOVE.W (A1)+,(A0)+
           DBRA   D0,lLoop
           ADD.L  #60+92,A7
           |
           | In user mode zurück schalten
           |
           DC.W   $027C,$DFFF         | Back to user Mode
           |
           | High level routine aufrufen
           |
           PEA    (A7)
           JSR    MMUCall
           |
           | Zurück in Supervisor mode
           |
           MOVE.L 4,A6
           JSR    -$96(A6)            | Supervisor
           |
           | Exception frame wieder auf Supervisor Stack
           |
           MOVE.L A7,A0               | User Stack
           MOVE.L D0,A7               | Supervisorstack
           SUB.L  #60+92,A7
           MOVE.L A7,A1
           MOVE.L #30+46-1,D0
  lLoop2:  MOVE.W (A0)+,(A1)+
           DBRA   D0,lLoop2
           DC.W   $4E60               | MOVE.L A0,USP
           |
           | Register zurück holen und Exception beenden
           |
  exit:    MOVE.L (A7)+,D0-D7/A0-A6
           RTE);
END BusError;


TYPE ProcPtr = POINTER TO PROC;

TYPE ShortPtr = POINTER TO SHORTSET;

CONST OldAllocMem = ARRAY OF PROC:(NIL);
      OldFreeMem  = ARRAY OF PROC:(NIL);
      OldAvailMem = ARRAY OF PROC:(NIL);

|
| SaveAllocMem, FreeMem, AvailMem:
|
|    Erweiterung der AllocMem.. Funktion um eine Semaphore. Ein einfaches Forbid
|    reicht nich mehr, da der anfordernde Task ja durch eine eventuelle Swap
|    Operation unterbrochen werden könnte, und dann die Speicherliste bei
|    gleichzeitiger Anforderung durch einen anderen Task beim Teufel wäre.
|
PROCEDURE SaveAllocMem;
BEGIN
  ASSEMBLE(MOVE.L D0-D1,-(A7)
           LEA    MemSem,A0
           JSR    -564(A6)
           MOVE.L (A7)+,D0-D1
           MOVE.L OldAllocMem,A0
           JSR    (A0)
           MOVE.L D0,-(A7)
           LEA    MemSem,A0
           JSR    -570(A6)
           MOVE.L (A7)+,D0
           RTS);
END SaveAllocMem;

PROCEDURE SaveFreeMem;
BEGIN
  ASSEMBLE(MOVE.L D0/A1,-(A7)
           LEA    MemSem,A0
           JSR    -564(A6)
           MOVE.L (A7)+,D0/A1
           MOVE.L OldFreeMem,A0
           JSR    (A0)
           MOVE.L D0,-(A7)
           LEA    MemSem,A0
           JSR    -570(A6)
           MOVE.L (A7)+,D0
           RTS);
END SaveFreeMem;

PROCEDURE SaveAvailMem;
BEGIN
  ASSEMBLE(MOVE.L D1,-(A7)
           LEA    MemSem,A0
           JSR    -564(A6)
           MOVE.L (A7)+,D1
           MOVE.L OldAvailMem,A0
           JSR    (A0)
           MOVE.L D0,-(A7)
           LEA    MemSem,A0
           JSR    -570(A6)
           MOVE.L (A7)+,D0
           RTS);
END SaveAvailMem;

LIBRARY Exec.ExecBase BY -636 PROCEDURE CacheClearU();

|
| GetStartupParams:
|
|    Parameter des Swappers aus dem Icon ermitteln.
|
PROCEDURE GetStartupParams;
FROM Strings     IMPORT Str;
FROM Dos         IMPORT FileLockPtr,CurrentDir;
FROM Icon        IMPORT FreeDiskObject,FindToolType;
FROM Workbench   IMPORT DiskObjectPtr,StartupMsg;
FROM Conversions IMPORT HexStringToInt,StringToInt,IntToHexString;

VAR lock    : FileLockPtr;
    ptr     : System.SysStringPtr;
    obj     : DiskObjectPtr;

LIBRARY Icon.IconBase BY -78  PROCEDURE GetDiskObject(Name IN A0 : ANYPTR):DiskObjectPtr;

BEGIN
  IF StartupMsg#NIL THEN
    lock:=CurrentDir(StartupMsg.argList[0].lock);
    obj:=GetDiskObject(StartupMsg.argList[0].name);
    FORGET CurrentDir(lock);
    IF obj=NIL THEN
      Terminate("Could not find icon");
    END;

    ptr:=FindToolType(obj.toolTypes,"SWAPFILE".data'PTR);
    IF ptr=NIL THEN
      Terminate("Parameter error:",
                "No Swapfile/Partition defined",
                "Use 'SWAPFILE=...'");
    END;
    SwapFileName:=Str(ptr);

    ptr:=FindToolType(obj.toolTypes,"SWAPBUFFER".data'PTR);
    IF ptr=NIL THEN
      Terminate("Parameter error:",
                "No Swapbuffer defined",
                "Use 'SWAPBUFFER=...'",
                "In blocks of 8KBytes");
    END;
    TRY
      PhysSize:=NodeSize*StringToInt(Str(ptr));
    EXCEPT
    ELSE
      Terminate("Parameter error:",
              "Swapbuffer not valid",
              "Use 'SWAPBUFFER=...'",
              "In blocks of 8KBytes");
    END;

    ptr:=FindToolType(obj.toolTypes,"FILESIZE".data'PTR);
    IF ptr#NIL THEN
      TRY
        SwapSize:=NodeSize*16*StringToInt(Str(ptr));
      EXCEPT
      ELSE
        Terminate("Parameter error:",
                  "Swapsize not valid",
                  "Use 'FILESIZE=...'",
                  "In blocks of 128KBytes");
      END;
    END;

    ptr:=FindToolType(obj.toolTypes,"LOOKAHEAD".data'PTR);
    IF ptr#NIL THEN
      TRY
        LookAhead:=StringToInt(Str(ptr));
        IF LookAhead NOT OF 4..255 THEN
          Terminate("Parameter error:",
                  "Lookahead size",
                  "out of range",
                  "Use 'LOOKAHEAD=...'",
                  "between 4 and 255");
        END;
      EXCEPT
      ELSE
        Terminate("Parameter error:",
                "Lookahead size not valid",
                "Use 'LOOKAHEAD=...'",
                "In blocks of 8KBytes");
      END;
    END;

    ptr:=FindToolType(obj.toolTypes,"VMEMBASE".data'PTR);
    IF ptr#NIL THEN
      TRY
        VMemBase:=HexStringToInt(Str(ptr));
        IF LookAhead NOT OF $08000000..LONGINT'MAX THEN
          Terminate("Parameter error:",
                    "VMem base",
                    "out of range",
                    "Use VMEMBASE=...'",
                    "between 08000000 and 7FFFFFFF");
        END;
      EXCEPT
      ELSE
        Terminate("Parameter error:",
                  "VMem base address not valid",
                  "Use 'VMEMBASE=...'",
                  "08000000 to 7FFFFFFF");
      END;
    END;
  ELSE
    Terminate("This is a WB programm");
  END;
END GetStartupParams;

BEGIN
  GetStartupParams;

  |
  | Dieser Test wirkt etwas gewagt, da er auch bei möglichen Spiegelungen
  | auf einen A3000 schließt. Dies dürfte aber keine Nachteile mit sich bringen,
  | da ja das Kickstart dann auf eine seiner Spiegelungen gemappt wird.
  |
  isA3000:=(LongPtr($F80000)^=LongPtr($7F80000)^) AND
           (LongPtr($F81234)^=LongPtr($7F81234)^) AND
           (LongPtr($FC0000)^=LongPtr($7FC0000)^) AND
           (LongPtr($FC0064)^=LongPtr($7FC0064)^);
  VBR:=GetVBR();


  oldIllegal[0]:=ProcPtr(VBR+$8)^;
  myA4[0]:=REG(A4);

  Exec.InitSemaphore(MemSem);
  ServerPort.sigBit:=32;

  DiskIO.Open(SwapFileName,SwapSize);

  Exec.Forbid;
  OldAllocMem[0]:=Exec.SetFunction(Exec.ExecBase,-198,SaveAllocMem);
  OldFreeMem[0] :=Exec.SetFunction(Exec.ExecBase,-210,SaveFreeMem);
  OldAvailMem[0]:=Exec.SetFunction(Exec.ExecBase,-216,SaveAvailMem);
  CacheClearU;
  Exec.Permit;

  Exec.FindTask(NIL).name:="Swapper".data'PTR;

  ServerPort.flags:=Exec.signal;
  ServerPort.sigBit:=Exec.AllocSignal(-1);
  ServerPort.sigTask:=Exec.ExecBase.thisTask;
  ServerPort.msgList.head:=Exec.NodePtr(ServerPort.msgList.tail'PTR);
  ServerPort.msgList.tail:=NIL;
  ServerPort.msgList.tailPred:=Exec.NodePtr(ServerPort.msgList.head'PTR);

  ProcPtr(VBR+$8)^:=BusError;
  GetMMUConfig(SysMMU);
  CreateMMUTree(OwnMMU);
  IF isA3000 THEN
    INCL(ShortPtr($DE0002)^,7);
  END;
  PutMMUConfig(OwnMMU);

  AddBuffers(PhysSize DIV NodeSize);
  CreateVMemArea(OwnMMU,VMemBase,VMemBase+SwapSize);
  FORGET Exec.SetTaskPri(Exec.FindTask(NIL),8);
  SwapMemIn(VMemBase);
  FORGET Exec.AddMemList(SwapSize,
                         Exec.MemReqSet:{Exec.fast,Exec.MemReqs(8)},
                         127,
                         VMemBase,"VMEM");
  Server;

CLOSE
  IF SysMMU.tc#MMUTCFlagSet:{} THEN
    PutMMUConfig(SysMMU);
  END;
  IF oldIllegal[0]#NIL THEN
    ProcPtr(VBR+$8)^:=oldIllegal[0];
  END;
  IF isA3000 THEN
    EXCL(ShortPtr($DE0002)^,7);
  END;
  IF ServerPort.sigBit#32 THEN
    Exec.FreeSignal(ServerPort.sigBit);
  END;
END VirtualMemory.